home *** CD-ROM | disk | FTP | other *** search
- {
-
- Most simple example of adding a menu item to Exchange
- or Outlook.
-
- }
-
-
-
- unit ComExample2;
-
- interface
-
- uses
- Windows,
- SysUtils,
- CommCtrl,
- ExchExt;
-
-
- type
- TExchExt = class(TInterfacedObject, IExchExt, IExchExtCommands)
- protected
- { IExchExt }
- function Install(
- eecb: IEXCHEXTCALLBACK;
- mecontext: ULONG;
- ulFlags: ULONG): HResult; stdcall;
- { IExchExtCommands }
- function InstallCommands(
- eecb: IEXCHEXTCALLBACK;
- hwnd: HWND;
- hmenu: HMENU;
- var cmdidBase: UINT;
- lptbeArray: LPTBENTRY;
- ctbe: UINT;
- ulFlags: ULONG): HResult; stdcall;
- procedure InitMenu(
- eecb: IExchExtCallback); stdcall;
- function DoCommand(
- eecb: IEXCHEXTCALLBACK;
- cmdid: UINT): HResult; stdcall;
- function Help(
- eecb: IEXCHEXTCALLBACK;
- cmdid: UINT): HResult; stdcall;
- function QueryHelpText(
- cmdid: UINT;
- ulFlags: ULONG;
- lpsz: LPTSTR;
- cch: UINT): HResult; stdcall;
- function QueryButtonInfo(
- tbid: ULONG;
- itbb: UINT;
- ptbb: PTBButton;
- lpsz: LPTSTR;
- cch: UINT;
- ulFlags: ULONG): HResult; stdcall;
- function ResetToolbar(
- tbid: ULONG;
- ulFlags: ULONG): HResult; stdcall;
- private
- CurrentContext: ULONG;
- MyMainButtonIndex,
- MyMainButtonBitmapNo,
- MyMainButtonCommand: integer;
- MyNewMsgWinButtonIndex,
- MyNewMsgWinButtonBitmapNo,
- MyNewMsgWinButtonCommand: integer;
- MyNewMsgMenuCommand: integer;
- end;
-
-
-
- implementation
-
- uses
- Graphics,
- Dialogs,
- Outlook_TLB;
-
-
- { IExchExt }
-
- function TExchExt.Install(
- eecb: IEXCHEXTCALLBACK;
- mecontext: ULONG;
- ulFlags: ULONG): HResult;
- var
- ulBuildVersion: ULONG;
- begin
- { make sure this is the right version... }
- eecb.GetVersion(ulBuildVersion, EECBGV_GETBUILDVERSION);
- if (EECBGV_BUILDVERSION_MAJOR <> (ulBuildVersion and EECBGV_BUILDVERSION_MAJOR_MASK)) then begin
- Result := S_FALSE;
- Exit;
- end;
-
- CurrentContext := mecontext;
-
- { in which context(s) do we want to show up? }
- case mecontext of
- EECONTEXT_VIEWER,
- EECONTEXT_SENDNOTEMESSAGE: Result := S_OK;
- else
- Result := S_FALSE;
- end; { of case }
-
- end;
-
-
-
- { IExchExtCommands }
-
- function TExchExt.InstallCommands(
- eecb: IEXCHEXTCALLBACK;
- hwnd: HWND;
- hmenu: HMENU;
- var cmdidBase: UINT;
- lptbeArray: LPTBENTRY;
- ctbe: UINT;
- ulFlags: ULONG): HResult;
- var
- r: HResult;
-
- function GetStandardToolbar(var hwndToolbar: Windows.HWnd; var MyButtonIndex: ULONG): Boolean;
- var
- i: integer;
- lptbe: LPTBENTRY;
- begin
- Result := False;
- lptbe := lptbeArray;
- for i := ctbe-1 downto 0 do begin
- if lptbe.tbid = EETBID_STANDARD then begin
- hwndToolbar := lptbe.hwnd;
- MyButtonIndex := lptbe.itbbBase;
- Inc(lptbe.itbbBase);
- Result := True;
- break;
- end;
- Inc(lptbe);
- end;
- end;
-
- procedure AddMainWindowButton;
- var
- hwndToolbar: Windows.HWnd;
- tbab: TTBAddBitmap;
- begin
- // add a bitmap to the bitmap list of the toolbar
- if GetStandardToolbar(hwndToolbar, MyMainButtonIndex) then begin
- tbab.hInst := SysInit.HInstance;
- tbab.nID := 101;
- MyMainButtonBitmapNo := SendMessage(hwndToolBar, TB_ADDBITMAP, 1, LPARAM(@tbab));
- MyMainButtonCommand := cmdidBase;
- Inc(cmdidBase);
- end;
- end;
-
- procedure AddNewMessageMenuItemAndButton;
- var
- hMenuTools: Windows.HMENU;
- hwndToolbar: Windows.HWnd;
- tbab: TTBAddBitmap;
- begin
- r := eecb.GetMenuPos(EECMDID_ToolsOptions, hMenuTools, nil, nil, 0);
- if r <> S_OK then begin
- r := S_FALSE;
- Exit;
- end;
-
- // add a menu separator
- AppendMenu(
- hMenuTools,
- MF_SEPARATOR,
- 0,
- nil);
-
- // add our extension command
- MyNewMsgMenuCommand := cmdidBase;
- AppendMenu(
- hMenuTools,
- MF_BYPOSITION and MF_STRING,
- MyNewMsgMenuCommand,
- 'Create a contact');
- Inc(cmdidBase);
-
- // add a bitmap to the bitmap list of the toolbar
- if GetStandardToolbar(hwndToolbar, MyNewMsgWinButtonIndex) then begin
- tbab.hInst := SysInit.HInstance;
- tbab.nID := 102;
- MyNewMsgWinButtonBitmapNo := SendMessage(hwndToolBar, TB_ADDBITMAP, 1, LPARAM(@tbab));
- MyNewMsgWinButtonCommand := cmdidBase;
- Inc(cmdidBase);
- end;
- // the bitmap itself is installed in QueryButtonInfo
-
- r := S_OK;
- end;
-
- begin
- case CurrentContext of
- EECONTEXT_VIEWER: AddMainWindowButton;
- EECONTEXT_SENDNOTEMESSAGE: AddNewMessageMenuItemAndButton;
- else
- r := S_FALSE;
- end;
- Result := r;
- end;
-
-
- procedure TExchExt.InitMenu(
- eecb: IExchExtCallback);
- begin
- // do nothing
- end;
-
-
- function TExchExt.DoCommand(
- eecb: IEXCHEXTCALLBACK;
- cmdid: UINT): HResult;
-
- procedure DumpSubjectsInCurrentFolder;
-
- function GetTempPath: string;
- const
- BufSize = 1024;
- var
- Buf: array[0..BufSize] of char;
- len: dword;
- begin
- len := Windows.GetTempPath(BufSize, Buf);
- Buf[len] := #0;
- Result := Buf;
- end;
-
- var
- app: Application;
- expl: Explorer;
- folder: MAPIFolder;
- msg: MailItem;
- i: integer;
- fdump: TextFile;
- subject: string;
- ThisIsAMailItem: Boolean;
- begin
- AssignFile(fdump, GetTempPath + '\dump.txt');
- Rewrite(fdump);
- try
- app := CoApplication.Create;
- expl := app.ActiveExplorer;
- folder := expl.CurrentFolder;
- for i := 1 to folder.Items.Count do begin
- msg := MailItem(folder.Items.Item(i));
- ThisIsAMailItem := msg.MessageClass = 'IPM.Note';
- if ThisIsAMailItem then begin
- subject := msg.Subject;
- writeln(fdump, subject);
- end;
- end;
- finally
- CloseFile(fdump);
- end;
- end;
-
- procedure CreateJournalAndDisplayIt;
- const
- ShowItModal = True;
- var
- app: Application;
- namespc: NameSpace;
- username: string;
- ji: _DJournalItem;
- begin
- app := CoApplication.Create;
- namespc := app.GetNameSpace('MAPI');
- username := namespc.CurrentUser.Name;
- ji := app.CreateItem(olJournalItem) as _DJournalItem;
- ji.Subject := Format('On %s I, %s, have created a mail message', [DateToStr(Date), username]);
- ji.Type_ := 'E-mail message';
- ji.Body := 'Hello World';
- ji.Start := Now;
- ji.Display(ShowItModal);
- { call ji.Save to save it }
- end;
-
- procedure CreateNewContact;
- var
- app: Application;
- ci: ContactItem;
- begin
- app := CoApplication.Create;
- ci := app.CreateItem(olContactItem) as _DContactItem;
- ci.FirstName := 'Berend';
- ci.MiddleName := 'de';
- ci.LastName := 'Boer';
- ci.FullName := 'Berend de Boer';
- ci.CompanyName := 'NederWare';
- ci.Email1Address := 'berend@pobox.com';
- ci.Email1AddressType := 'SMTP';
- ci.HomeAddressCity := 'Gameren';
- ci.HomeAddressCountry := 'The Netherlands';
- ci.Subject := 'Guess what, this is my name!';
- ci.Body := 'Outlook''s object model is powerful, isn''t it?';
- ci.Save;
- end;
-
- begin
- if cmdid = MyMainButtonCommand
- then begin
- DumpSubjectsInCurrentFolder;
- Result := S_OK;
- end
- else if cmdid = MyNewMsgMenuCommand
- then begin
- CreateNewContact;
- Result := S_OK;
- end
- else if cmdid = MyNewMsgWinButtonCommand
- then begin
- CreateJournalAndDisplayIt;
- Result := S_OK;
- end
- else
- Result := S_FALSE;
- end;
-
-
- function TExchExt.Help(
- eecb: IEXCHEXTCALLBACK;
- cmdid: UINT): HResult;
- begin
- Result := S_FALSE;
- end;
-
-
- function TExchExt.QueryHelpText(
- cmdid: UINT;
- ulFlags: ULONG;
- lpsz: LPTSTR;
- cch: UINT): HResult;
- begin
- Result := S_FALSE;
- end;
-
-
- function TExchExt.QueryButtonInfo(
- tbid: ULONG;
- itbb: UINT;
- ptbb: PTBButton;
- lpsz: LPTSTR;
- cch: UINT;
- ulFlags: ULONG): HResult;
- begin
- if (CurrentContext = EECONTEXT_SENDNOTEMESSAGE) and
- (tbid = EETBID_STANDARD) and
- (itbb = MyNewMsgWinButtonIndex)
- then begin
- ptbb.iBitmap := MyNewMsgWinButtonBitmapNo;
- ptbb.idCommand := MyNewMsgWinButtonCommand;
- ptbb.fsState := TBSTATE_ENABLED;
- ptbb.fsStyle := TBSTYLE_BUTTON;
- ptbb.dwData := 0;
- ptbb.iString := -1;
- lstrcpyn(lpsz, 'Create a journal item', cch);
- Result := S_OK;
- end
- else if (CurrentContext = EECONTEXT_VIEWER) and
- (tbid = EETBID_STANDARD) and
- (itbb = MyMainButtonIndex)
- then begin
- ptbb.iBitmap := MyMainButtonBitmapNo;
- ptbb.idCommand := MyMainButtonCommand;
- ptbb.fsState := TBSTATE_ENABLED;
- ptbb.fsStyle := TBSTYLE_BUTTON;
- ptbb.dwData := 0;
- ptbb.iString := -1;
- lstrcpyn(lpsz, 'Dump all current subjects', cch);
- Result := S_OK;
- end
- else
- Result := S_FALSE;
- end;
-
-
- function TExchExt.ResetToolbar(
- tbid: ULONG;
- ulFlags: ULONG): HResult;
- begin
- Result := S_OK;
- end;
-
-
-
- end.
-